home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ftpser1a / findfold.frm < prev    next >
Text File  |  1999-08-24  |  4KB  |  144 lines
  1. VERSION 5.00
  2. Begin VB.Form FindFolder 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "FindFolder"
  5.    ClientHeight    =   5070
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   3600
  9.    LinkTopic       =   "FindFile"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   5070
  13.    ScaleWidth      =   3600
  14.    StartUpPosition =   1  'CenterOwner
  15.    Begin VB.CommandButton FldrDone 
  16.       Caption         =   "Done"
  17.       Height          =   375
  18.       Left            =   960
  19.       TabIndex        =   2
  20.       Top             =   4600
  21.       Width           =   1575
  22.    End
  23.    Begin VB.TextBox DirPath 
  24.       Height          =   285
  25.       Left            =   120
  26.       TabIndex        =   1
  27.       Top             =   120
  28.       Width           =   3375
  29.    End
  30.    Begin VB.ListBox FolderList 
  31.       BeginProperty Font 
  32.          Name            =   "Terminal"
  33.          Size            =   9
  34.          Charset         =   255
  35.          Weight          =   400
  36.          Underline       =   0   'False
  37.          Italic          =   0   'False
  38.          Strikethrough   =   0   'False
  39.       EndProperty
  40.       Height          =   4020
  41.       ItemData        =   "FindFolder.frx":0000
  42.       Left            =   120
  43.       List            =   "FindFolder.frx":0002
  44.       Sorted          =   -1  'True
  45.       TabIndex        =   0
  46.       Top             =   480
  47.       Width           =   3375
  48.    End
  49. End
  50. Attribute VB_Name = "FindFolder"
  51. Attribute VB_GlobalNameSpace = False
  52. Attribute VB_Creatable = False
  53. Attribute VB_PredeclaredId = True
  54. Attribute VB_Exposed = False
  55. Option Explicit
  56. Dim DrvS(32) As String
  57. Dim LastStr As String
  58. Dim DrvC As Integer
  59.  
  60. Private Sub FldrDone_Click()
  61.   Form_Terminate
  62. End Sub
  63.  
  64. Private Sub FolderList_Click()
  65. Dim s As String, t As String, s2 As String
  66. Dim i As Integer
  67.   i = FolderList.ListIndex + 1
  68.   s2 = FolderList.Text
  69.   If Mid(s2, 1, 1) = "[" Then
  70.     s2 = Mid(s2, 2, 2) & "\"
  71.     DirPath = s2
  72.   Else
  73.     If FolderList.Text = ".." Then
  74.       s = Left(LastStr, Len(LastStr) - 1)
  75.       Do Until Right(s, 1) = "\"
  76.         s = Left(s, Len(s) - 1)
  77.       Loop
  78.       s2 = s
  79.       DirPath = s2
  80.     Else
  81.       s2 = DirPath & FolderList.Text & "\"
  82.       DirPath = s2
  83.     End If
  84.   End If
  85.   LastStr = s2
  86.   FolderList.Clear
  87.   'Debug.Print i; s2
  88.   s = FindFile("*.*", s2)
  89.   Add_Drives
  90. End Sub
  91.  
  92. Private Sub Form_Load()
  93. Dim s As String
  94.   GetSystemDrives 'load the system drives
  95.   If AddEditDir.Tag <> "" Then
  96.     LastStr = AddEditDir.Tag
  97.     DirPath = LastStr
  98.     s = FindFile("*.*", AddEditDir.Tag)
  99.   End If
  100.   Add_Drives
  101. End Sub
  102.  
  103. Private Sub Add_Drives()
  104. Dim x As Integer
  105.   For x = 1 To DrvC
  106.     FolderList.AddItem "[" & DrvS(x) & "]"
  107.   Next
  108. End Sub
  109. Private Sub Form_Terminate()
  110.   AddEditDir.Tag = DirPath.Text
  111.   Unload Me
  112. End Sub
  113.  
  114. Private Sub GetSystemDrives()
  115. Dim rtn As Long
  116. Dim d As Integer
  117. Dim AllDrives As String
  118. Dim CurrDrive As String
  119. Dim tmp As String
  120.   tmp = Space(64)
  121.   rtn = GetLogicalDriveStrings(64, tmp)
  122.   AllDrives = Trim(tmp)               'get the list of all available drives
  123.   d = 0
  124.   Do Until AllDrives = Chr$(0)
  125.     d = d + 1
  126.     CurrDrive = StripNulls(AllDrives) 'strip off one drive item from the allDrives
  127.     CurrDrive = Left(CurrDrive, 2)    'we can't have the trailing slash, so ..
  128.     DrvS(d) = CurrDrive
  129.     DrvC = d
  130.   Loop
  131. End Sub
  132.  
  133. Private Function StripNulls(startstr) As String
  134. Dim pos As Integer
  135.   pos = InStr(startstr, Chr$(0))
  136.   If pos Then
  137.     StripNulls = Mid(startstr, 1, pos - 1)
  138.     startstr = Mid(startstr, pos + 1, Len(startstr))
  139.     Exit Function
  140.   End If
  141. End Function
  142.  
  143.  
  144.